{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit modTunnelGestion;

interface

uses Classes,
     HttpProt,
     modTunnelSessionId,
     Windows,
     WSocketS;


type

    TTunnelHttpState = (hcAttenteFirstLineHeader, hcAttenteFinHeader, hcAttenteFinDonneesPoste, hcForceClose);





    TTunnelHttpConnection = class(TWSocketClient)
    protected
        //FRequestHeader         : TStringList;
        FState                 : TTunnelHttpState;


        FOpenFile              : TFileStream;


        // tampon de lecture
        FBuffer                : string;

        // première ligne de la requete
        FMethod                : String;
        FVersion               : String;
        FPathRequest           : String;

        // données postées par le client
        FPostedData            : string;
        FDataGet               : string;

        // autres champs de la requete
        FRequestContentLength  : Integer;
        FRequestContentType    : String;
        FRequestAccept         : String;
        FRequestReferer        : String;
        FRequestAcceptLanguage : String;
        FRequestAcceptEncoding : String;
        FRequestAcceptEncodingGZip: boolean;
        FRequestAcceptEncodingDeflate: boolean;

        FRequestIfNoneMatch    : string;

        FRequestUserAgent      : String;
        FRequestAuth           : String;
        FRequestCookies        : String;
        FRequestHost           : String;
        FRequestHostName       : String;
        FRequestHostPort       : String;
        FRequestConnection     : String;


        // Protective Critical Section object
        ReadWriteCS: TRTLCriticalSection;




        // propre procédure de reception de données

        procedure TraitementHeaderFromBuffer;

        // lorsque l'header a été lu
        procedure TriggerOnHeaderLu;

        // Lorsque le client a effectué une requete (header + données postées si il y en a)
        procedure TriggerClientRequete;


        procedure InitRequestInfos;

        procedure SendStream(stream: TStream);

        procedure Lock;
        procedure Unlock;

    public
        kOnRequest             : TNotifyEvent;
        ReponseContentType     : string;
        ReponseAdditionalHeader: string;  // pour les cookies

        SocketRelay: THttpCli;
        SessionId   : PTunnelSessionId;


        procedure MakeNoCache;

        
        function GetRequestCookie(Nom: string): string;
        function GetRequestPOST(Nom: string): string;
        function GetRequestGET(Nom: string): string;

        property RequestMethod          : String      read  FMethod;
        property RequestVersion         : String      read  FVersion;
        property RequestPath            : String      read  FPathRequest;
        property RequestPostedData      : String      read  FPostedData;


        { All RequestXXX are header fields from request header }
        property RequestContentLength  : Integer     read  FRequestContentLength;
        property RequestContentType    : String      read  FRequestContentType;
        property RequestAccept         : String      read  FRequestAccept;
        property RequestReferer        : String      read  FRequestReferer;
        property RequestAcceptLanguage : String      read  FRequestAcceptLanguage;
        property RequestAcceptEncoding : String      read  FRequestAcceptEncoding;
        property RequestUserAgent      : String      read  FRequestUserAgent;
        property RequestAuth           : String      read  FRequestAuth; {DAVID}
        property RequestCookies        : String      read  FRequestCookies;
        property RequestHost           : String      read  FRequestHost;
        property RequestHostName       : String      read  FRequestHostName;    {DAVID}
        property RequestHostPort       : String      read  FRequestHostPort;    {DAVID}
        property RequestConnection     : String      read  FRequestConnection;

        property RequestIfNoneMatch            : String     read  FRequestIfNoneMatch;

        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

        procedure lOnClientDataAvailable(Sender: TObject; Error: Word);



        procedure SendPageWeb(sDataPageWeb: string; hStatusCode: integer = 200);
        procedure SendFile(Fichier: string; AutoAjustContentType: boolean);
        function GetBasicHeader(StatusCode: integer): string;

        procedure MakeErreur(StatusCode: integer; NoPageWeb: boolean = false);
        procedure MakeRedirection(Path: string);
        procedure MakeNonModified;

        procedure SetCookie(Nom, Valeur: string; Expires: int64 = 0; Path: string = '');
        procedure AddHeaderLigne(Ligne: string);

    end;

    function tlgExtractLocation(s: TStrings): string;
    function tlgCalculETag(Fichier: string): string;

var
   Global_DontUseCompressionIE: boolean;

implementation

uses ESBDates,
     SysUtils,
     sFonctionsChaines,
     ZlibEx,
     modMimeType,
     WSocket,
     modHttpProtocolStatusCode;



function tlgfGetFileTimes(const FileName: string; var Created: TDateTime;
  var Accessed: TDateTime; var Modified: TDateTime): Boolean; 
var
  h: THandle; 
  Info1, Info2, Info3: TFileTime; 
  SysTimeStruct: SYSTEMTIME; 
  TimeZoneInfo: TTimeZoneInformation; 
  Bias: Double; 
begin 
  Result := False; 
  Bias   := 0; 
  h      := FileOpen(FileName, fmOpenRead or fmShareDenyNone);

  if h > 0 then begin
    try 
      if GetTimeZoneInformation(TimeZoneInfo) <> $FFFFFFFF then 
         Bias := TimeZoneInfo.Bias / 1440; // 60x24

      GetFileTime(h, @Info1, @Info2, @Info3);
      if FileTimeToSystemTime(Info1, SysTimeStruct) then 
         Created := SystemTimeToDateTime(SysTimeStruct) - Bias;
      if FileTimeToSystemTime(Info2, SysTimeStruct) then
         Accessed := SystemTimeToDateTime(SysTimeStruct) - Bias;
      if FileTimeToSystemTime(Info3, SysTimeStruct) then 
         Modified := SystemTimeToDateTime(SysTimeStruct) - Bias;
      Result := True; 
    finally 
      FileClose(h); 
    end; 
  end; 
end;

function tlgfGetFileSize(const APath: string): int64;
var Sr : TSearchRec;
begin
  if FindFirst(APath,faAnyFile,Sr)=0 then
     try
        Result := Int64(Sr.FindData.nFileSizeHigh) shl 32 + Sr.FindData.nFileSizeLow;
     finally
        SysUtils.FindClose(Sr);
     end
  else
     Result := 0;
end;

function tlgCalculETag(Fichier: string): string;
var FileSize: int64;
    dCreate, dAccess, dModified: TDateTime;
    duCreate: int64;
begin

   if FileExists(Fichier) = false then begin
      Result := '';
      exit;
   end;

   FileSize := tlgfGetFileSize(Fichier);

   if tlgfGetFileTimes(Fichier, dCreate, dAccess, dModified) then begin
      duCreate := DateTimeToUnix(dCreate);

   end else begin
      duCreate := 0;
   end;

   Result := 'Y' + IntToStr(FileSize) + 'Q' + IntToStr(duCreate);
end;


procedure TTunnelHttpConnection.Lock;
begin
    EnterCriticalSection(ReadWriteCS);
end;

procedure TTunnelHttpConnection.Unlock;
begin
    LeaveCriticalSection(ReadWriteCS);
end;

procedure TTunnelHttpConnection.MakeNonModified;
begin
     MakeErreur(304, true);
end;

procedure TTunnelHttpConnection.MakeNoCache;
begin
(*
header("Expires: Mon, 26 Jul 1997 05:00:00 GMT");
header("Last-Modified: " . gmdate("D, d M Y H:i:s") . " GMT");
header("Cache-Control: no-store, no-cache, must-revalidate");
header("Cache-Control: post-check=0, pre-check=0", false);
header("Pragma: no-cache");             *)

    AddHeaderLigne('Cache-Control: no-cache, must-revalidate');
    AddHeaderLigne('Pragma: no-cache');




end;

procedure TTunnelHttpConnection.MakeRedirection(Path: string);
begin
     AddHeaderLigne('Location: ' + Path);
     SendPageWeb('', 302);
end;






const
   CRLF = #$0D#$0A;

function tlgExtractLocation(s: TStrings): string;
var i: integer;
    Ligne, sKey: string;
    xPos: integer;
begin

    Result := '';
    
    if s.Count = 0 then exit;

    for i := 0 to s.Count - 1 do begin
       Ligne := s.Strings[i];
       xPos := pos(':', Ligne);

       if xPos = 0 then
          Continue;

       sKey := copy(Ligne, 1, xPos - 1);
       if SameText(sKey, 'Location') then begin
          Result := trim(copy(Ligne, xPos + 1, maxint));
          exit;
       end;
    end;

end;




function TTunnelHttpConnection.GetRequestGET(Nom: string): string;
var xPos: integer;
    Key, Current, Buffer: string;
begin
    Result := '';
    Buffer := FDataGet;

    repeat
        xPos := pos('&', Buffer);

        if xPos < 1 then begin
           Current := Buffer;
           Buffer  := '';
        end else begin
           Current := copy(Buffer, 1, xPos - 1);
           System.Delete(Buffer, 1, xPos);
        end;

        xPos := pos('=', Current);
        if xPos = 0 then
           // impossible
           break;

        Key := copy(Current, 1, xPos - 1);
        System.Delete(Current, 1, xPos);

        if SameText(Key, Nom) then begin
           Result := Current;
           exit;
        end;

    until False;


end;


function TTunnelHttpConnection.GetRequestPOST(Nom: string): string;
var xPos: integer;
    Key, Current, Buffer: string;
begin
    Result := '';
    Buffer := FPostedData;

    repeat
        xPos := pos('&', Buffer);

        if xPos < 1 then begin
           Current := Buffer;
           Buffer  := '';
        end else begin
           Current := copy(Buffer, 1, xPos - 1);
           System.Delete(Buffer, 1, xPos);
        end;

        xPos := pos('=', Current);
        if xPos = 0 then
           // impossible
           break;

        Key := copy(Current, 1, xPos - 1);
        System.Delete(Current, 1, xPos);

        if SameText(Key, Nom) then begin
           Result := Current;
           exit;
        end;

    until False;


end;


function TTunnelHttpConnection.GetRequestCookie(Nom: string): string;
var xPos: integer;
    Key, Current, Buffer: string;
begin
    Result := '';
    Buffer := FRequestCookies;

    repeat
        xPos := pos(';', Buffer);

        if xPos < 1 then begin
           Current := Buffer;
           Buffer  := '';
        end else begin
           Current := copy(Buffer, 1, xPos - 1);
           System.Delete(Buffer, 1, xPos);
        end;

        xPos := pos('=', Current);
        if xPos = 0 then
           // impossible
           break;

        Key := copy(Current, 1, xPos - 1);
        System.Delete(Current, 1, xPos);

        if SameText(Key, Nom) then begin
           Result := Current;
           exit;
        end;

    until False;

    
end;


procedure TTunnelHttpConnection.AddHeaderLigne(Ligne: string);
begin
    ReponseAdditionalHeader := ReponseAdditionalHeader + Ligne + CRLF;

end;

procedure TTunnelHttpConnection.SetCookie(Nom, Valeur: string; Expires: int64 = 0; Path: string = '');
var Ligne: string;
begin
    //Set-Cookie: AMA=1119036327; expires=Fri, 17-Jun-05 19:25:27 GMT; path=/

    Ligne := format('Set-Cookie: %s=%s', [Nom, Valeur]);

    if Expires > 0 then begin
       Ligne := Ligne + '; expires=' + ESBRFC1123_Date(0.0);
    end;

    if Path <> '' then begin
       Ligne := Ligne + '; path=' + Path;
    end;

    AddHeaderLigne(Ligne);

end;

procedure TTunnelHttpConnection.InitRequestInfos;
begin
        FMethod                := '';
        FVersion               := '';
        FPathRequest           := '';

        DateTimeToUnix(Now);


        // données postés par le client
        FPostedData            := '';
        FDataGet               := '';


        FRequestContentLength  := 0;
        FRequestContentType    := '';
        FRequestAccept         := '';
        FRequestReferer        := '';
        FRequestAcceptLanguage := '';
        FRequestAcceptEncoding := '';
        FRequestUserAgent      := '';
        FRequestAuth           := '';
        FRequestCookies        := '';
        FRequestHost           := '';
        FRequestHostName       := '';
        FRequestHostPort       := '';
        FRequestConnection     := '';

        FRequestIfNoneMatch           := '';

        FRequestAcceptEncodingGZip    := false;
        FRequestAcceptEncodingDeflate := false;


        ReponseContentType := '';
        ReponseAdditionalHeader := '';

end;

procedure TTunnelHttpConnection.SendStream(stream: TStream);
const TAILLE_TAMPON = 4096;
var Tampon: string;
    NbLu: integer;
begin

     Lock;

     SetLength(Tampon, TAILLE_TAMPON);

     while (stream.Position < stream.Size) do begin

        NbLu := stream.Read(Tampon[1], TAILLE_TAMPON);

        if NbLu < TAILLE_TAMPON then begin
           System.Delete(Tampon, NbLu + 1, maxint);
           SendStr(Tampon);
           Sleep(1);
           break;
        end else begin
          SendStr(Tampon);
        end;

        if State <> wsConnected then begin
           // le client a fermé la connexion
           break;
        end;

     end;

     if State = wsConnected then
        Flush;

     Unlock;

end;

procedure TTunnelHttpConnection.SendFile(Fichier: string; AutoAjustContentType: boolean);
label lSendFileNoCompression;
var FileExtension: string;
    bUseCompression: boolean;
    FIn: TFileStream;

    CompressionStream: TZCompressionStream;
    OutputStream: TMemoryStream;
begin

    if FileExists(Fichier) = false then begin
       // 404 not found
       MakeErreur(PROTOCOL_HTTP_ERREUR);
       exit;
    end;

    // http://www.utoronto.ca/webdocs/HTMLdocs/Book/Book-3ed/appb/mimetype.html
    FileExtension := ExtractFileExt(Fichier);
    if FileExtension <> '' then
       System.Delete(FileExtension, 1, 1);


    ReponseContentType := mtGetMimeTypeFromExtension(FileExtension, bUseCompression);

    if ReponseContentType = '' then begin
       // inconnu...
       ReponseContentType := 'application/octet-stream';
       bUseCompression := false;
    end;

    try
      FIn := TFileStream.Create(Fichier, fmOpenRead);
    except
      FIn := nil;
    end;

    if FIn = nil then begin
       MakeErreur(PROTOCOL_HTTP_INTERNAL_ERROR);
       exit;
    end;


    // 1 Mo = 1048576
    if FIn.Size > 3145728 then begin
       // pas de compression obligatoirement
       // le fichier est trop gros pour l'être
       bUseCompression := false;
    end;

    SendStr(GetBasicHeader(200));

    if bUseCompression and FRequestAcceptEncodingDeflate then begin

       OutputStream := TMemoryStream.Create;

       CompressionStream := TZCompressionStream.Create(OutputStream, zcMax);
       CompressionStream.CopyFrom(FIn, FIn.Size);
       CompressionStream.Free;

       OutputStream.Seek(0, soBeginning);


       if OutputStream.Size > FIn.Size then begin
          // la compression augmente la taille du fichier...
          OutputStream.Free;
          FIn.Seek(0, soBeginning);
          goto lSendFileNoCompression;
       end;

       FIn.Free;

       SendStr('Content-Length: ' + IntToStr(OutputStream.Size) + CRLF);
       SendStr('Content-Encoding: deflate' + CRLF);

       // envoi le CRLF supplémentaire
       SendStr(CRLF);


       SendStream(OutputStream);

       OutputStream.Free;


    end else begin
lSendFileNoCompression:
       FOpenFile := FIn;

       SendStr('Content-Length: ' + IntToStr(FIn.Size) + CRLF);

       // envoi le CRLF supplémentaire
       SendStr(CRLF);

       SendStream(Fin);
       FIn.Free;
       FOpenFile := nil;
    end;

    // ferme la connexion
    CloseDelayed;
    FState := hcForceClose;

end;

procedure TTunnelHttpConnection.SendPageWeb(sDataPageWeb: string; hStatusCode: integer = 200);
var sHeader: string;
    CompressionStream: TZCompressionStream;
    InputStream, OutputStream: TMemoryStream;
    sEncoding: string;
    bError: boolean;
begin


    Lock;

    if (sDataPageWeb = '') and (hStatusCode = 200) then
       // la page est vide lors de relocation par exemple (ou d'erreur)
       sDataPageWeb := 'Erreur';


    sEncoding := '';

    if (FRequestAcceptEncodingDeflate) and (length(sDataPageWeb) > 5) then begin
        bError := false;
        OutputStream      := nil;
        CompressionStream := nil;
        InputStream       := nil;

        try
           InputStream := TMemoryStream.Create;
           InputStream.Write(sDataPageWeb[1], length(sDataPageWeb));
           InputStream.Seek(0, soBeginning);
           OutputStream := TMemoryStream.Create;

           CompressionStream := TZCompressionStream.Create(OutputStream, zcMax);
           CompressionStream.CopyFrom(InputStream, InputStream.Size);
        except
           bError := true;
        end;

        if CompressionStream <> nil then
           CompressionStream.Free;

        if InputStream <> nil then
           InputStream.Free;


        if (bError = false) and (OutputStream <> nil) and (length(sDataPageWeb) > OutputStream.Size) then begin
           // compression utile
           sEncoding := 'deflate';

           SetLength(sDataPageWeb, OutputStream.Size);
           OutputStream.Seek(0, soBeginning);
           OutputStream.Read(sDataPageWeb[1], OutputStream.Size);

           OutputStream.Free;

        end else begin
           if OutputStream <> nil then
              OutputStream.Free;

        end;


    end;


    if ReponseContentType = '' then
       ReponseContentType := 'text/html';

    sHeader := GetBasicHeader(hStatusCode);


    // envoi l'header
    SendStr(sHeader);


    try
       SendStr('Content-Length: ' + IntToStr(length(sDataPageWeb)) + CRLF);

       if sEncoding <> '' then begin
          SendStr('Content-Encoding: ' + sEncoding + CRLF);
       end;


       // envoi le CRLF supplémentaire
       SendStr(CRLF);


       if length(sDataPageWeb) > 0 then begin
          // envoi le contenu
          SendStr(sDataPageWeb);
       end;


       if State = wsConnected then begin
          // ferme la connexion
          Flush;
          CloseDelayed;
       end;

    finally
       FState := hcForceClose;
    end;

    Unlock;

end;



procedure TTunnelHttpConnection.MakeErreur(StatusCode: integer; NoPageWeb: boolean = false);
var sHeader, sMsg: string;
    sPageWeb: string;
begin

  case StatusCode of
      302: sMsg := 'Moved Temporarily';
      304: sMsg := 'Not Modified';

      400: sMsg := 'Bad Request';
      401: sMsg := 'Unauthorized';
      402: sMsg := 'Payment Required';
      403: sMsg := 'Forbidden';
      404: sMsg := 'Not Found';
      405: sMsg := 'Method Not Allowed';
      406: sMsg := 'Not Acceptable';
      407: sMsg := 'Proxy Authentication Required';
      408: sMsg := 'Request Timeout';
      409: sMsg := 'Conflict';
      410: sMsg := 'Gone';
      411: sMsg := 'Length Required';
      412: sMsg := 'Precondition Failed';
      413: sMsg := 'Request Entity Too Large';
      414: sMsg := 'Request-URI Too Long';
      415: sMsg := 'Unsupported Media Type';
      416: sMsg := 'Requested Range Not Satisfiable';
      417: sMsg := 'Expectation Failed';

      500: sMsg := 'Internal Server Error';
  end;

   if NoPageWeb then begin
     sPageWeb := '';
     ReponseContentType := '';
   end else begin
     sPageWeb := 'Erreur ' + IntToStr(StatusCode) + ' - ' + sMsg;
     ReponseContentType := 'text/html';
   end;



    sHeader := FVersion + ' ' + IntToStr(StatusCode) + ' ' + sMsg + CRLF +
               'Server: Apache/1.3.28 (Unix) PHP/4.2.3' + CRLF +
               'Connection: close' + CRLF +
               'Accept-Ranges: bytes' + CRLF +
               'Content-Length: ' + IntToStr(length(sPageWeb)) + CRLF;


    if ReponseContentType <> '' then
      sHeader := sHeader + 'Content-Type: ' + ReponseContentType + CRLF;
      

    // envoi l'header
    SendStr(sHeader);

    // envoi le CRLF supplémentaire
    SendStr(CRLF);


    if NoT(NoPageWeb) then
       SendStr(sPageWeb);


    // ferme la connexion
    CloseDelayed;
    FState := hcForceClose;

end;

function TTunnelHttpConnection.GetBasicHeader(StatusCode: integer): string;
begin
(*
HTTP/1.1 200 OK
Date: Wed, 05 Nov 2003 10:46:04 GMT
Server: Apache/1.3.28 (Unix) PHP/4.2.3
Content-Location: CSS2-REC.en.html
Vary: negotiate,accept-language,accept-charset
TCN: choice
P3P: policyref=http://www.w3.org/2001/05/P3P/p3p.xml
Cache-Control: max-age=21600
Expires: Wed, 05 Nov 2003 16:46:04 GMT
Last-Modified: Tue, 12 May 1998 22:18:49 GMT
ETag: "3558cac9;36f99e2b"
Accept-Ranges: bytes
Content-Length: 10734
Connection: close
Content-Type: text/html; charset=utf-8
Content-Language: en
*)
    if ReponseContentType = '' then
       ReponseContentType := 'text/html';

    if StatusCode < 100 then
       StatusCode := 200;

    Result := FVersion + ' ' + IntToStr(StatusCode) + ' OK' + CRLF +
               'Server: Apache/1.3.28 (Unix) PHP/4.2.3' + CRLF +
               'Connection: close' + CRLF +
               'Accept-Ranges: bytes' + CRLF +
               'Content-Type: ' + ReponseContentType + CRLF +
               ReponseAdditionalHeader;


end;


constructor TTunnelHttpConnection.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);

    InitRequestInfos;
    FState := hcAttenteFirstLineHeader;

    FBuffer := '';
    SocketRelay := nil;

    // Create critical section object:
    InitializeCriticalSection(ReadWriteCS);

    FOpenFile := nil;
end;

destructor TTunnelHttpConnection.Destroy;
begin

    if SocketRelay <> nil then begin
       if SocketRelay.State <> httpReady then begin
          SocketRelay.Abort;
          Sleep(1);

          // fermeture bloquante
          SocketRelay.Close;
       end;


       SocketRelay.Free;
       SocketRelay := nil;
    end;

    if FOpenFile <> nil then begin
       FOpenFile.Free;
       FOpenFile := nil;
    end;

    inherited Destroy;
end;


procedure TTunnelHttpConnection.TriggerClientRequete;
var xPos: integer;
begin
    FState := hcAttenteFirstLineHeader;


    if FRequestAcceptEncoding <> '' then begin
       FRequestAcceptEncoding := lowercase(FRequestAcceptEncoding);
       if pos('gzip', FRequestAcceptEncoding) > 0 then
          FRequestAcceptEncodingGZip    := true;

       if pos('deflate', FRequestAcceptEncoding) > 0 then
          FRequestAcceptEncodingDeflate    := true;


       if Global_DontUseCompressionIE then begin
          if FRequestAcceptEncodingGZip or FRequestAcceptEncodingDeflate then begin
             if pos('MSIE 6.0', uppercase(FRequestUserAgent)) > 0 then begin
                FRequestAcceptEncodingGZip    := false;
                FRequestAcceptEncodingDeflate := false;
             end;

          end;

       end;

    end;


    // extrait les données du get
    xPos := LastDelimiter('?', FPathRequest);
    if xPos > 0 then begin
       FDataGet := copy(FPathRequest, xPos + 1, maxint);
    end else begin
       FDataGet := '';
    end;


    if Assigned(kOnRequest) then begin
       kOnRequest(Self);
    end else begin
       // on ferme la connexion
       Close;
       FState := hcForceClose;
    end;
end;

procedure TTunnelHttpConnection.TriggerOnHeaderLu;
begin
    if FRequestContentLength = 0 then begin
       // la requete est terminée
       TriggerClientRequete;

    end else begin
       // sinon on doit lire les données postées...
       // mais peut-être existent-elles déjà ?
       // on force l'évènement lOnClientDataAvailable
       FState :=  hcAttenteFinDonneesPoste;

       lOnClientDataAvailable(Self, 0);
    end;
    

end;

procedure TTunnelHttpConnection.TraitementHeaderFromBuffer;
var Ligne, Key: string;
    xPos: integer;
begin

(*
GET /page.html HTTP/1.0
Host: example.com
Referer: http://example.com/
User-Agent: CERN-LineMode/2.15 libwww/2.17b3
*)

    repeat
        Ligne := sfcGetLigneUnixOrWin(FBuffer);

        if sfcGetLigneUnixOrWin_NoData then break;

        if Ligne = '' then begin
           // le reste correspond aux données postés ou à une autre requete
           TriggerOnHeaderLu;
           break;
        end;

        if FState = hcAttenteFirstLineHeader then begin
           // GET /page.html HTTP/1.0
           InitRequestInfos;

           FMethod      := sfcTokenGet(Ligne, 1, ' ');
           FPathRequest := sfcTokenGet(Ligne, 2, ' ');
           FVersion     := sfcTokenGet(Ligne, 3, ' ');

           if (SameText(FMethod, 'GET') = false) and (SameText(FMethod, 'POST') = false) then begin
              // requete invalide
              FState := hcForceClose;
              Close;
              exit;
           end;

           // on attend la fin de l'header maintenant
           FState := hcAttenteFinHeader;

           
        end else if FState = hcAttenteFinHeader then begin

           xPos := pos(':', Ligne);
           if xPos < 1 then begin
              // requete invalide
              FState := hcForceClose;
              Close;
              exit;
           end;

           Key := copy(Ligne, 1, xPos - 1);
           System.Delete(Ligne, 1, xPos + 1);

           if SameText(Key, 'host') then begin
              FRequestHost := Ligne;

           end else if SameText(Key, 'Accept-Encoding') then begin
              // Accept-Encoding: gzip, deflate
              FRequestAcceptEncoding := Ligne;



           end else if SameText(Key, 'User-Agent') then begin
              // Referer: http://xxxx
              FRequestUserAgent := Ligne;


           end else if SameText(Key, 'Referer') then begin
              // Referer: http://xxxx
              FRequestReferer := Ligne;



           end else if SameText(Key, 'Content-Length') then begin
              try
                 FRequestContentLength := StrToIntDef(Ligne, -1);
              except
                 FRequestContentLength := -1;
              end;



              if FRequestContentLength < 0 then begin
                 FState := hcForceClose;
                 Close;
                 exit;

              end else if FRequestContentLength > 0 then begin
                 // on doit télécharger les données postées
                 if SameText(FMethod, 'GET') then begin
                    // pas de données postées lors d'un GET
                    FState := hcForceClose;
                    Close;
                    exit;
                 end;

                 // on autorise 100ko maxi de données
                 if FRequestContentLength > 102400 then begin
                     MakeErreur(413);
                     exit;
                 end;


                 //FState :=  hcAttenteFinDonneesPoste;
              end;

              
           end else if SameText(Key, 'Cookie') then begin
              FRequestCookies := Ligne;


           end else if SameText(Key, 'If-None-Match') then begin
              FRequestIfNoneMatch := Ligne;

              // fucking quote with IE
              xPos := pos('"', FRequestIfNoneMatch);
              if xPos > 0 then begin
                 System.Delete(FRequestIfNoneMatch, xPos, 1);

                 xPos := LastDelimiter('"', FRequestIfNoneMatch);
                 if xPos > 0 then begin
                    System.Delete(FRequestIfNoneMatch, xPos, 1);
                 end;

              end;


           end;

        end;

    until false;

end;


procedure TTunnelHttpConnection.lOnClientDataAvailable(Sender: TObject; Error: Word);
var s: TTunnelHttpConnection;
    DataRecu: string;
begin

    s := TTunnelHttpConnection(Sender);

    if s.FState = hcForceClose then begin
       // vide le tampon
       DataRecu := s.ReceiveStr;
       s.Close;
       exit;
    end;


    FBuffer := FBuffer + s.ReceiveStr;


    if (s.FState = hcAttenteFinHeader) or
       (s.FState = hcAttenteFirstLineHeader) then begin


       s.TraitementHeaderFromBuffer;

    end else if s.FState = hcAttenteFinDonneesPoste then begin
       if length(FBuffer) >= FRequestContentLength then begin
          // données postées récupérées
          FPostedData := copy(FBuffer, 1, FRequestContentLength);
          System.Delete(FBuffer, 1, FRequestContentLength);

          TriggerClientRequete;
       end;

    end;





end;

initialization
     Global_DontUseCompressionIE := true;

end.
